#!/usr/bin/env perl

use warnings;
use strict;
use Getopt::Long;

use constant OUTPUT_DELIMITER => ':';
use constant EMPTY_STR        => q{};

MAIN: {
    my $prn_len     = 1;
    my $help        = 0;
    my $prn_match   = 1;
    my $ignore_case = 1;

    if (GetOptions(
            'help|h'         => \$help,
            'length|l!'      => \$prn_len,
            'match|m!'       => \$prn_match,
            'ignore-case|i!' => \$ignore_case
        ) == 0
        )
    {
        usage_and_exit(1, "Wrong parameters.");
    }
    
    if ($help) {
        usage_and_exit(0);
    }

    my ($query, $fasta);
    ($query, $fasta) = @ARGV;
    if (!defined($query) || $query !~ /\w/) {
        usage_and_exit(1, "No query pattern specified.");
    }
    $fasta = '-' if (!defined($fasta) || $fasta eq EMPTY_STR);

    my %SEQS        = ();
    my $curr_contig = EMPTY_STR;
    open FA, $fasta
        or die "Cannot open $fasta file for input: $!\n";
    while (<FA>) {
        chomp;
        if (/^>\s*(\S+)/) {
            $curr_contig = $1;
            next;
        }
        $SEQS{$curr_contig} ||= [];
        push @{ $SEQS{$curr_contig} }, lc $_;
    }

    my $print_match;
    {
        my @print_fields = ();
        push @print_fields, 'name';
        push @print_fields, 'position';
        push @print_fields, 'length' if ($prn_len);
        push @print_fields, 'match' if ($prn_match);
        $print_match = sub {
            my ($params) = @_;
            print join(OUTPUT_DELIMITER, map { $params->{$_} } @print_fields),
                "\n";
        };
    }
    my $ignore_flag = $ignore_case == 1 ? '(?i)' : EMPTY_STR;
    for my $seq_name (sort keys %SEQS) {
        my $subject = join EMPTY_STR, @{ $SEQS{$seq_name} };
        my $count = 0;

        while ($subject =~ m/$ignore_flag$query/gcx) {
            $count++;
            my $match    = $&;
            my $length   = length($match);
            my $position = (pos($subject) - $length);
            $print_match->(
                {   name     => $seq_name,
                    position => $position,
                    length   => $length,
                    match    => $match
                }
            );
        }
    }
    exit 0;
}

sub usage_and_exit {
    my ($code, $message) = @_;
    print "$message\n" if (defined $message);
    print <<END_USAGE;
USAGE
    $0 [options] PATTERN FASTA_FILE
    
SYNOPSIS
    Print matches of a sequence pattern in a FASTA file

OPTIONS
   -h, --help
          Display these instructions

   -i/-no-i, --ignore-case/--no-ignore-case
          Ignore case distinction in pattern and input files (DEFAULT: on)

   -l/-no-l, --length/--no-length
          print length of match pattern (DEFAULT: on)

   -m/-no-m, --match/--no-match
          Print match pattern (DEFAULT: on)

END_USAGE
    exit $code;
}
